home *** CD-ROM | disk | FTP | other *** search
/ Saar AMOK 2 / Saar AMOK II - Oktober 1994 (1994)(Kreativ Marketing)(DE)[!][I-7598].iso / disks / amok / amok_092 / magicclip / magicclip.mod < prev    next >
Text File  |  1993-08-05  |  7KB  |  199 lines
  1. (* OPREFS OberonOpts mda  OLinkOpts smdia *)
  2. (* --------------------------------------------------------------------------
  3.   :Program.       MagicClip.mod
  4.   :Contents.      Shell interface for Clipboard text
  5.   :Author.        Franz Schwarz
  6.   :Copyright.     Freeware (freely distributable, copyrighted software)
  7.   :Language.      Oberon-2
  8.   :Translator.    Amiga Oberon 3.00
  9.   :History.       v1.0 19-Jul-93 fSchwarz
  10.   :History.       v1.1  5-Aug-93 fSchwarz - workaround for V37 Dos.Flush()
  11.   :History.         enforcer hit (fixed in V39 Dos) when wbStarted, fixed
  12.   :History.         OpenIFF()/CloseIFF() ressource freeing bug
  13.   :History.       v1.2  5-Aug-93 fSchwarz - fixed magic newline insertion
  14.   :History.         added environment variable support for ID text that
  15.   :History.         separates 2 chunks & for ID text at the end of all text
  16.   :History.         added CTRL_C break checking
  17.   :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  18.   :Address.       uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
  19.   :Remark.        Amiga-Oberon 3.00 checks string pointers to be even if
  20.   :Remark.        OddChk is enabled: thus don't compile with OddChk.
  21.   :Usage.         "UNIT/K/N,GET/S,FILE/K,PUT/F"
  22. -------------------------------------------------------------------------- *)
  23.  
  24. MODULE MagicClip;
  25.  
  26. IMPORT 
  27.   st: Strings, e: Exec, d: Dos, I: Intuition, iff: IFFParse, 
  28.   o: OberonLib, y: SYSTEM;
  29.  
  30. CONST
  31.   verTag = "\000$VER: MagicClip 1.2 (5.8.93) © Franz.Schwarz@mil.ka.sub.org - Freeware";
  32.   
  33.   templ = "UNIT/K/N,GET/S,FILE/K,PUT/F";
  34.   
  35.   varSize      = 256;
  36.   chunkSepName = "MAGICCLIPCHUNKSEP";
  37.   endTxtName   = "MAGICCLIPENDTXT";
  38.  
  39. TYPE
  40.   LStrPtr = UNTRACED POINTER TO ARRAY MAX (LONGINT)-1 OF CHAR;
  41.  
  42.   LongIntStruct = STRUCT
  43.     l: LONGINT;
  44.   END;
  45.  
  46. CONST
  47.   bufSize = 256;
  48.  
  49.   unit0 = LongIntStruct (0);
  50.   
  51.   idFTXT = y.VAL (LONGINT, 'FTXT');
  52.   idCHRS = y.VAL (LONGINT, 'CHRS');
  53.  
  54.   wroteThisChunk = 0;
  55.   wroteLastChunk = 1;
  56.  
  57. TYPE
  58.   ArgsT = STRUCT
  59.     unit: UNTRACED POINTER TO LONGINT;
  60.     get : LONGINT;
  61.     file: LStrPtr;
  62.     put : LStrPtr;
  63.   END;  
  64.  
  65. VAR
  66.   iffh    : iff.IFFHandlePtr;
  67.   cn      : iff.ContextNodePtr;  
  68.   fh      : d.FileHandlePtr;
  69.   rda     : d.RDArgsPtr;
  70.   args    : ArgsT;
  71.   c       : LONGINT;  
  72.   tcnk    : BOOLEAN;
  73.   wrte    : SET;
  74.   buf     : ARRAY bufSize OF CHAR;
  75.   chunksep: ARRAY varSize OF CHAR;
  76.   endtxt  : ARRAY varSize OF CHAR;
  77.   iffopn  : BOOLEAN;
  78.   chseplen: LONGINT;
  79.   endtxlen: LONGINT;
  80.  
  81. PROCEDURE Halt (ret: LONGINT);
  82. BEGIN
  83.   o.Result := ret;
  84.   o.HaltProc ();
  85. END Halt;
  86.   
  87. BEGIN
  88.   IF o.wbStarted THEN I.DisplayBeep (NIL); Halt (d.fail); END;
  89.   IF d.dos.lib.version < 37 THEN
  90.     y.SETREG (0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
  91.     Halt (d.fail);
  92.   END;
  93.   IF iff.base = NIL THEN d.PrintF ("Need iffparse.library!\n"); Halt (d.fail); END;
  94.   rda := d.ReadArgs (templ, args, NIL);
  95.   IF rda = NIL THEN Halt (d.fail); END;
  96.   IF args.unit = NIL THEN args.unit := y.ADR (unit0); END;
  97.   IF (args.unit^ < 0) OR (args.unit^ > 255) THEN
  98.     y.SETREG (0, d.SetIoErr (d.badNumber)); Halt (d.fail); 
  99.   END;  
  100.   c := 0; IF args.get # 0 THEN INC (c); END;
  101.   IF args.file # NIL THEN INC (c); END; IF args.put # NIL THEN INC (c); END;
  102.   IF c > 1 THEN y.SETREG (0, d.SetIoErr (d.tooManyArgs)); Halt (d.fail); END;
  103.   IF c < 1 THEN y.SETREG (0, d.SetIoErr (d.requiredArgMissing)); Halt (d.fail); END;
  104.   iffh := iff.AllocIFF ();
  105.   IF iffh = NIL THEN Halt (d.fail); END;
  106.   iffh.stream := y.VAL (LONGINT, iff.OpenClipboard (args.unit^));
  107.   IF iffh.stream = NIL THEN Halt (d.fail); END;
  108.   iff.InitIFFasClip (iffh);
  109.   IF args.get # 0 THEN
  110.     chseplen := d.GetVar (chunkSepName, chunksep, LEN (chunksep), LONGSET{d.binaryVar});
  111.     IF chseplen < 0 THEN COPY ("\n", chunksep); chseplen := 1; END;
  112.     endtxlen := d.GetVar (endTxtName, endtxt, LEN (endtxt), LONGSET{d.binaryVar});
  113.     IF endtxlen < 0 THEN endtxlen := 0; END;
  114.     iffopn := iff.OpenIFF (iffh, iff.read) = 0;
  115.     IF ~iffopn THEN Halt (d.fail); END;
  116.     IF iff.StopChunk (iffh, idFTXT, idCHRS) # 0 THEN Halt (d.fail); END;
  117.     LOOP
  118.       CASE iff.ParseIFF (iffh, iff.iffParseScan) OF
  119.       iff.IFFErrEOC: |
  120.       iff.IFFErrEOF, iff.IFFErrNotIFF:
  121.         IF tcnk THEN Halt (d.ok); ELSE Halt (d.warn); END; |
  122.       0:
  123.         cn := iff.CurrentChunk (iffh);
  124.         IF cn # NIL THEN IF cn.type = idFTXT THEN IF cn.id = idCHRS THEN
  125.           tcnk := TRUE;
  126.           REPEAT
  127.             IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN 
  128.               y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
  129.             END;  
  130.             c := iff.ReadChunkBytes (iffh, buf, LEN (buf));
  131.             IF c < 0 THEN Halt (d.fail); END;
  132.             IF c > 0 THEN
  133.               IF (wroteLastChunk IN wrte) & (chseplen > 0) THEN
  134.                 IF d.FWrite (d.Output (), chunksep, 1, chseplen) # chseplen THEN Halt (d.fail); END;
  135.               END;  
  136.               wrte := {wroteThisChunk};
  137.               IF d.FWrite (d.Output (), buf, 1, c) # c THEN Halt (d.fail); END;
  138.             END;  
  139.           UNTIL c < LEN (buf);
  140.           IF wroteThisChunk IN wrte THEN wrte := {wroteLastChunk}; END;
  141.         END; END; END; (* IF *)
  142.       ELSE
  143.         Halt (d.fail);
  144.       END;
  145.     END;
  146.   ELSE
  147.     IF args.file # NIL THEN
  148.       fh := d.Open (args.file^, d.oldFile);
  149.       IF fh = NIL THEN Halt (d.fail); END;
  150.     END;
  151.     iffopn := iff.OpenIFF (iffh, iff.write) = 0;
  152.     IF ~iffopn THEN Halt (d.fail); END;
  153.     IF iff.PushChunk (iffh, idFTXT, iff.idFORM, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
  154.     IF iff.PushChunk (iffh, 0, idCHRS, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
  155.     IF fh = NIL THEN
  156.       IF iff.WriteChunkBytes (iffh, args.put^, st.Length (args.put^)) < 0 THEN Halt (d.fail); END;
  157.     ELSE
  158.       LOOP
  159.         IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN 
  160.           y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
  161.         END;  
  162.         y.SETREG (0, d.SetIoErr (0));
  163.         c := d.FRead (fh, buf, 1, LEN (buf));
  164.         IF c > 0 THEN
  165.           IF iff.WriteChunkBytes (iffh, buf, c) < 0 THEN Halt (d.fail); END;
  166.         ELSE
  167.           IF d.IoErr () = 0 THEN EXIT; ELSE Halt (d.fail); END;
  168.         END;
  169.       END; (* LOOP *)
  170.     END; (* IF fh = NIL *)
  171.     IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
  172.     IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
  173.     Halt (d.ok);
  174.   END;
  175.   
  176.   Halt (-1); (* we should never reach this point! *)
  177.  
  178. CLOSE
  179.   IF fh # NIL THEN d.OldClose (fh); END;
  180.   IF iffh # NIL THEN
  181.     IF iffopn THEN iff.CloseIFF (iffh); END;
  182.     IF iffh.stream # 0 THEN iff.CloseClipboard (y.VAL (e.APTR, iffh.stream)); END;
  183.     iff.FreeIFF (iffh);
  184.   END;
  185.   IF rda # NIL THEN d.FreeArgs (rda); END;
  186.   IF d.dos.lib.version >= 37 THEN 
  187.     IF o.Result > d.warn THEN 
  188.       IF wrte # {} THEN d.PrintF ("\n"); END;
  189.       d.PrintF ("%s failed!\n", y.ADR (verTag[7])); 
  190.     ELSE
  191.       IF (wrte # {}) & (endtxlen > 0) THEN
  192.         IF d.FWrite (d.Output (), endtxt, 1, endtxlen) = 0 THEN END;
  193.       END;  
  194.       d.Flush (d.Output ());
  195.     END;  
  196.   END;
  197. END MagicClip.
  198.  
  199.